home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
t_os
/
fb386lnc
/
fb386lnc.bas
next >
Wrap
BASIC Source File
|
1993-11-30
|
8KB
|
299 lines
10 '***************************************
20 '* BASLNCNV.BAS Copyright A.Okuyama *
30 '* BASIC Line Number Convert Program *
40 '* 1993, 5,17 Ver. 1.00 1993, 5,17 *
50 '***************************************
60 '
70 '
80 '
90 '==============================
100 *SETUP
110 COLOR 7
120 CLEAR
130 '***** 編集可能ソースファイルサイズ *****
140 MAXPTR&=300000 '(Bytes)
150 '****************************************
160 DIM WORD%(INT(MAXPTR&/2)),CMD$(17),O_FILE$(3)
170 DIM L2G(65528),LABEL%(65528)
180 O_FILE$(0)="SCRN:"
190 EOPROC%=0
200 SPTAB%=4
210 FOR C%=0 TO 17
220 READ CMD$(C%)
230 NEXT C%
240 DATA "CHAIN" , "DELETE", "ELSE" , "THEN", "GOSUB", "GOS."
250 DATA "GOTO" , "GO." , "LIST" , "L." , "LLIST", "RENUM"
260 DATA "RESTORE", "RESUME", "RETURN", "RET.", "RUN" , "R."
270 '==============================
280 *START
290 'CLS:PRINT FRE(1);FRE(3);FRE(4):END:CLS
300 PRINT "============================================================="
310 PRINT "FB386 Line Number Convert Program . Copyright A.Okuyama 1993"
320 PRINT "============================================================="
330 LINE INPUT "Input File Name. :",I_FILE$
340 LINE INPUT "Output File Name. :",O_FILE$(1)
350 PRINT "============================================================="
360 IF I_FILE$="" OR O_FILE$(1)="" THEN *START
370 IF I_FILE$ ="E" OR I_FILE$ ="e" THEN END
380 IF I_FILE$ ="Q" OR I_FILE$ ="q" THEN END
390 IF O_FILE$(1)="E" OR O_FILE$(1)="e" THEN END
400 IF O_FILE$(1)="Q" OR O_FILE$(1)="q" THEN END
410 IF I_FILE$=O_FILE$(1) THEN *START
420 IF 0<INSTR(O_FILE$(1),".") THEN
430 O_FILE$(3)=LEFT$(O_FILE$(1),INSTR(O_FILE$(1),"."))
440 ELSE
450 O_FILE$(3)=O_FILE$(1)+"."
460 ENDIF
470 O_FILE$(1)=O_FILE$(3)+"NOL" 'NO Line number
480 O_FILE$(2)=O_FILE$(3)+"LON" 'Line number ON
490 O_FILE$(3)=O_FILE$(3)+"LOL" 'Llst Of Label
500 LOAD@ I_FILE$,WORD%
510 FOR SET%=1 TO 2
520 GOSUB *NEWPROC
530 *CKPROC
540 GOSUB *GETBYTE
550 GOSUB *WORD_CUT
560 IF EOPROC%<>SET% THEN *CKPROC
570 NEXT SET%
580 CLOSE #2
590 COLOR 6
600 OPEN O_FILE$(1) FOR INPUT AS #3
610 OPEN O_FILE$(2) FOR OUTPUT AS #2
620 GOSUB *LINE_ON
630 CLOSE #2,#3
640 OPEN O_FILE$(3) FOR OUTPUT AS #2
650 COLOR 7
660 GOSUB *LABELIST
670 *EOPROG
680 CLOSE
690 SYSTEM
700 '==============================
710 *NEWPROC
720 PTR&=0 'ファイル内BYTEポインター
730 LNO&=0 '行番号テーブル用論理行番号
740 COLUM=0 '行内BYTE位置
750 LABEL%=0 'ラベル作成指標
760 GYOU%=1 '行先頭の行番号判定
770 WORD$="" 'スペース区切りの単語文字列
780 MBYTE$=" " 'ファイルエンド判定
790 COMMENT%=0 '"ダブルコーテーションマーク内外判定"
800 MESSEGE%=0 'REM文内外判定
810 OPEN O_FILE$(SET%-1) FOR OUTPUT AS #SET%
820 COLOR 3+SET%
830 RETURN
840 '==============================
850 *GETBYTE
860 IF MAXPTR&<PTR& THEN *EOPROC
870 WORD&=WORD%(INT(PTR&/2))-(WORD%(INT(PTR&/2))<0)*&H10000
880 IF PTR&=INT(PTR&/2)*2 THEN
890 '~~~~~~~~~~~~ WORD%()の下位バイト
900 BYTE$=CHR$(WORD&-INT(WORD&/&H100)*&H100)
910 ELSE
920 '~~~~~~~~~~~~ WORD%()の上位バイト
930 BYTE$=CHR$(INT(WORD&/&H100))
940 ENDIF
950 IF BYTE$=CHR$(0) AND MBYTE$=CHR$(0) THEN *EOPROC
960 MBYTE$=BYTE$
970 RETURN
980 '==============================
990 *POUT
1000 FOR C%=1 TO SET%
1010 PRINT #C%,BYTE$;
1020 NEXT C%
1030 RETURN
1040 '==============================
1050 *WORD_CUT
1060 '~~~~~~~~~~~~ 2バイト文字
1070 IF (&H7F<ASC(BYTE$) AND ASC(BYTE$)<&HA0) OR &HDF<ASC(BYTE$) THEN
1080 IF BYTE$=CHR$(&H81) THEN
1090 PTR&=PTR&+1
1100 GOSUB *GETBYTE
1110 IF BYTE$=CHR$(&H40) AND COMMENT%=0 AND MESSEGE%=0 THEN
1120 GOSUB *WORD_CK
1130 BYTE$=" "
1140 IF SET%=1 OR GYOU%=0 THEN GOSUB *POUT
1150 GYOU%=0
1160 GOSUB *POUT
1170 ELSE
1180 WORD$=WORD$+CHR$(&H81)+BYTE$
1190 GYOU%=0
1200 ENDIF
1210 COLUM=COLUM+2
1220 PTR&=PTR&+1
1230 RETURN
1240 ENDIF
1250 GYOU%=0
1260 WORD$=WORD$+BYTE$
1270 PTR&=PTR&+1
1280 GOSUB *GETBYTE
1290 WORD$=WORD$+BYTE$
1300 COLUM=COLUM+2
1310 PTR&=PTR&+1
1320 RETURN
1330 ENDIF
1340 '~~~~~~~~~~~~ (0)"(1)コメント"(0)
1350 IF BYTE$=CHR$(&H22) AND MESSEGE%=0 THEN
1360 COMMENT%=ABS(COMMENT%-1)
1370 ENDIF
1380 '~~~~~~~~~~~~ (0)'(1)メッセージ
1390 IF BYTE$=CHR$(&H27) AND COMMENT%=0 THEN
1400 MESSEGE%=1
1410 ENDIF
1420 IF COMMENT%=0 AND MESSEGE%=0 THEN
1430 '~~~~~~~~~~~~ 半角スペース
1440 IF BYTE$=" " THEN
1450 GOSUB *WORD_CK
1460 COLUM=COLUM+1
1470 PTR&=PTR&+1
1480 IF SET%=1 OR GYOU%=0 THEN GOSUB *POUT
1490 GYOU%=0
1500 RETURN
1510 ENDIF
1520 '~~~~~~~~~~~~ コマンドライン区切り文字
1530 IF BYTE$=":" THEN
1540 GOSUB *WORD_CK
1550 COLUM=COLUM+1
1560 PTR&=PTR&+1
1570 GYOU%=0
1580 LABEL%=0
1590 GOSUB *POUT
1600 RETURN
1610 ENDIF
1620 '~~~~~~~~~~~~ コマンド区切り文字
1630 IF BYTE$="," OR BYTE$="-" THEN
1640 GOSUB *WORD_CK
1650 COLUM=COLUM+1
1660 PTR&=PTR&+1
1670 GYOU%=0
1680 GOSUB *POUT
1690 RETURN
1700 ENDIF
1710 ENDIF
1720 '~~~~~~~~~~~~ TAB
1730 IF BYTE$=CHR$(9) THEN
1740 GOSUB *WORD_CK
1750 IF SET%=1 OR GYOU%=0 THEN
1760 BYTE$=SPACE$(SPTAB%-(COLUM MOD SPTAB%))
1770 ELSE
1780 BYTE$=SPACE$(SPTAB%-(COLUM MOD SPTAB%)-1)
1790 ENDIF
1800 COLUM=COLUM+(SPTAB%-(COLUM MOD SPTAB%))
1810 PTR&=PTR&+1
1820 GYOU%=0
1830 GOSUB *POUT
1840 RETURN
1850 ENDIF
1860 '~~~~~~~~~~~~ CR
1870 IF BYTE$=CHR$(13) THEN
1880 GOSUB *WORD_CK
1890 COMMENT%=0
1900 MESSEGE%=0
1910 COLUM=0
1920 PTR&=PTR&+1
1930 LNO&=LNO&+1
1940 GYOU%=1
1950 LABEL%=0
1960 GOSUB *POUT
1970 RETURN
1980 ENDIF
1990 '~~~~~~~~~~~~ LF
2000 IF BYTE$=CHR$(10) THEN
2010 PTR&=PTR&+1
2020 GOSUB *POUT
2030 RETURN
2040 ENDIF
2050 '~~~~~~~~~~~~ 1バイト文字
2060 WORD$=WORD$+BYTE$
2070 COLUM=COLUM+1
2080 PTR&=PTR&+1
2090 IF BYTE$<"0" OR "9"<BYTE$ THEN
2100 GYOU%=0
2110 ENDIF
2120 RETURN
2130 '==============================
2140 *WORD_CK
2150 IF WORD$="" THEN
2160 GYOU%=0
2170 RETURN
2180 ENDIF
2190 IF COMMENT%=0 AND (WORD$="REM" OR LEFT$(WORD$,1)="'") THEN
2200 MESSEGE%=1
2210 ENDIF
2220 IF COMMENT%=1 OR MESSEGE%=1 THEN *WCK_PASS
2230 IF GYOU%=1 THEN
2240 IF SET%=1 THEN
2250 GOSUB *GYOU
2260 ELSE
2270 IF LABEL%(L2G(LNO&))=1 THEN
2280 WORD$="*L"+RIGHT$(STR$(100000+L2G(LNO&)),5)+CHR$(13)+CHR$(10)
2290 COLOR 7
2300 GOTO *WCK_PASS
2310 ELSE
2320 WORD$=""
2330 RETURN
2340 ENDIF
2350 ENDIF
2360 ENDIF
2370 CKWORD%=0
2380 FOR C=0 TO 17
2390 IF WORD$=CMD$(C) THEN
2400 LABEL%=1
2410 CKWORD%=1
2420 ELSE
2430 IF LEFT$(WORD$,1)<>"*" AND VAL(WORD$)=0 AND CKWORD%=0 THEN
2440 LABEL%=0
2450 ENDIF
2460 ENDIF
2470 NEXT C
2480 IF VAL(WORD$)<>0 THEN
2490 IF LABEL%=1 THEN
2500 IF SET%=1 THEN
2510 LABEL%(VAL(WORD$))=1
2520 ELSE
2530 WORD$="*L"+RIGHT$("00000"+WORD$,5)
2540 COLOR 7
2550 ENDIF
2560 ENDIF
2570 ENDIF
2580 *WCK_PASS
2590 FOR C%=1 TO SET%
2600 PRINT #C%,WORD$;
2610 NEXT C%
2620 WORD$=""
2630 COLOR 3+SET%
2640 RETURN
2650 '==============================
2660 *GYOU:' 行番号取得
2670 IF GYOU%=1 THEN
2680 L2G(LNO&)=VAL(WORD$)
2690 ENDIF
2700 RETURN
2710 '==============================
2720 *EOPROC
2730 EOPROC%=SET%
2740 RETURN
2750 '==============================
2760 *LINE_ON
2770 GYOU=1
2780 *NEW_LINE
2790 IF EOF(3) THEN RETURN
2800 LNO$=MID$(STR$(GYOU),2,5)+" "
2810 LINE INPUT #3,COMMAND$
2820 FOR C%=1 TO 2
2830 PRINT #C%,LNO$;COMMAND$
2840 NEXT C%
2850 GYOU=GYOU+1
2860 GOTO *NEW_LINE
2870 '==============================
2880 *LABELIST
2890 LNOMAX&=LNO&-1
2900 FOR LNO&=0 TO LNOMAX&
2910 IF LABEL%(L2G(LNO&))=1 THEN
2920 LOL$="*L"+RIGHT$(STR$(100000+L2G(LNO&)),5)
2930 FOR SET%=1 TO 2
2940 PRINT #SET%,LOL$
2950 NEXT SET%
2960 ENDIF
2970 NEXT LNO&
2980 RETURN